perm filename MEM[G,BGB]2 blob sn#025303 filedate 1973-02-17 generic text, type T, neo UTF8
00100	;-----------------------------------------------------------------
00200	INTERN OLD44,UNIVER,BLKCNT,AVAIL
00300		OLD44:	0
00400		UNIVER:	0
00500		BLKCNT: 0
00600		AVAIL:	0
00700		REMAINDER:0
00800		NODSIZ←←=12	;NUMBER OF WORDS PER NODE.
00900	SUBR(MORCOR)------------------------------------------------------
01000	BEGIN MORCOR; - GET MORE CORE - BGB - 4 DEC 1972.
01100	
01200	;INITIALIZE THE UNIVERSE NODE WHEN NECESSARY.
01300		SKIPE OLD44↔GO L1
01400		LAC 1,44↔DAC 1,OLD44
01500		ADDI 1,3↔DAC 1,BLKCNT
01550		ADDI 1,1↔DAC 1,AVAIL↔DAC 1,UNIVER
01800		SETZM REMAINDER
01900	
02000	;FOUR MORE K !
02100	L1:	LAC 1,44↔LAC 0,1↔ADDI 0,10000
02200		CALLI 11↔GO[FATAL(NO MORE CORE.)]
02300		AOS 1↔SUB 1,REMAINDER↔DAC 2,AC2#↔LAC 2,44
02400		SETZM(1)↔LIPI(1)↔LAPI(1)1↔BLT(2)
02500	
02600	;MAKE AVAIL LIST.
02700		DIP 1,1↔ADD 1,[XWD NODSIZ,0]
02800		SKIPN@BLKCNT↔GO[
02900			ADD 1,[XWD NODSIZ,NODSIZ]
02950			AOS@BLKCNT↔GO .+1]
03000		DAPZ 1,@AVAIL
03100	L2:	HLRZM 1,(1)
03150		ADD 1,[XWD NODSIZ,NODSIZ]
03200		CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L2
03250	
03300		SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
03400		LACI 10000↔LAC 1,UNIVER↔ADDM -3(1)
03500		LAC 1,@AVAIL
03600		LAC 2,AC2↔POP0J
03700	
03800	BEND;1/12/73------------------------------------------------------
     

00100	SUBR(MAKE)TYPE----------------------------------------------------
00200	BEGIN MAKE; ALLOCATE A BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
00300		SKIPN 1,@AVAIL↔CALL(MORCOR)
00400		CDR(1)↔DAP @AVAIL
00500		SETZM(1)↔AOS @BLKCNT↔ADDI 1,3
00600		POP P,.+3↔POP P,(1)↔GO @.+1↔0
00800	BEND;1/12/73------------------------------------------------------
00900	
01000	SUBR(KILL)NODE----------------------------------------------------
01100	BEGIN KILL; - RELEASE  BLOCK OF NODSIZ WORDS - BGB - 4 DEC 1972.
01200		LAC 1,ARG1
01300		SKIPN(1)↔GO[OUTSTR[ASCIZ/	AN EMPTY NODE KILLED.
01400	/]↔POP1J]↔SOS @BLKCNT
01500		LIPI -3(1)↔LAPI -2(1)↔SETZM -3(1)↔BLT 8(1)    ;CLEAR NODE.
01600		SUBI 1,3↔LAC@AVAIL↔DAPZ(1)↔DAPZ 1,@AVAIL
01700		POP1J
01800	BEND;1/12/73------------------------------------------------------
01900